home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO108.dsk / STANDARDS.bas < prev    next >
BASIC Source File  |  2012-02-16  |  37KB  |  601 lines
  1. 0  REM PRODOS VER 3 FAMILY ROOTS: STANDARDS PROGRAM. COPYRIGHT (C) 1987, STEPHEN C. VORENBERG
  2. 40  GOTO 16000
  3. 300 BB = W: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN W = W -PA(I) +Q(36) *I:SC(I) = SC(I) +1:I = Q(37)
  4. 305  NEXT :JJ =  LEN(NA$(W)):KK = 0:N1$ = "":N2$ = "":N3$ = "":N4$ = "": IF JJ = 0  THEN 400
  5. 310  FOR II =  LEN(NA$(W)) TO 1  STEP  -1: IF  MID$ (NA$(W),II,1) < >Q$(5)  THEN 380
  6. 320 KK = KK +1: IF II -JJ = 0  THEN 370
  7. 330  ON KK GOTO 360,350,340
  8. 340 N1$ =  MID$ (NA$(W),II +1,JJ -II): GOTO 370
  9. 350 N2$ =  MID$ (NA$(W),II +1,JJ -II): GOTO 370
  10. 360 N4$ =  RIGHT$(NA$(W),JJ -II)
  11. 370 JJ = II -1: IF KK = 3  THEN II = 1
  12. 380  NEXT : IF JJ -II >0  THEN N3$ =  LEFT$(NA$(W),JJ -II)
  13. 390  IF KK = 2  THEN N1$ = N2$:N2$ = N3$:N3$ = ""
  14. 400 W = BB: RETURN 
  15. 500  IF U <1  OR U >30  THEN  PRINT RN$"'S ON THIS TRIAL DISK MUST BE BETWEEN";: GOSUB 860: PRINT "1 AND 30.":U = 0
  16. 501  RETURN 
  17. 580  IF   NOT Q(1)  THEN  RETURN 
  18. 581  IF Q(41) >2  THEN  PRINT  CHR$(27) CHR$(17)
  19. 582  PRINT  CHR$(4)"PR#"Q(3)
  20. 586  PRINT Q$(1);: IF KN = 0  THEN  PRINT V3$;: IF Q(45)  THEN KN = 1
  21. 587  IF   NOT Q(46)  THEN  PRINT  CHR$(9) INT(KL)"N";
  22. 589  RETURN 
  23. 590  GOSUB 580: IF Q(47)  THEN  GOSUB 595: PRINT :Y1 = Y1 +1: GOSUB 608
  24. 591  RETURN 
  25. 595  GOSUB 680: RETURN 
  26. 598  GOTO 580
  27. 600  IF   NOT Q(1)  THEN  RETURN 
  28. 602  PRINT  CHR$(4)"PR#"Q(43): RETURN 
  29. 605  IF   NOT Q(1)  THEN  RETURN 
  30. 607  PRINT  CHR$(4)"PR#"Q(43): RETURN 
  31. 608  RETURN 
  32. 610  GOSUB 300: GOSUB 880:J = 0: IF   NOT OP(10)  THEN  GOSUB 628: GOSUB 643: GOSUB 652: GOSUB 660: GOTO 618
  33. 612  IF OP(12)  AND N3$ < >""  THEN 615
  34. 613 J = 1: GOSUB 643:J = 0: IF IX +2 < = FC  THEN  PRINT ", ";:IX = IX +2
  35. 614  GOSUB 628: GOSUB 660: GOTO 618
  36. 615 J = 1: GOSUB 652:J = 0: IF IX +2 < = FC  THEN  PRINT ", ";:IX = IX +2
  37. 616  GOSUB 628: GOSUB 643: GOSUB 660
  38. 618  IF   NOT OP(3)  THEN 627
  39. 619  IF OP(19)  THEN 623
  40. 620 N =  LEN( STR$(W)) +4 + LEN(RN$): IF IX +N >FC  THEN  GOSUB 665
  41. 621  PRINT " ("RN$"="W")";:IX = IX +N: GOTO 627
  42. 623  IF V2$ = ""  THEN 627
  43. 624 N =  LEN(V2$) +4 + LEN(ID$): IF IX +N >FC  THEN  GOSUB 665
  44. 625  PRINT " ("ID$"="V2$")";:IX = IX +N
  45. 627  GOSUB 2130: RETURN 
  46. 628  IF N1$ = ""  THEN  RETURN 
  47. 631  IF IX + LEN(N1$) < = FC  THEN  PRINT N1$;:IX = IX + LEN(N1$): RETURN 
  48. 634 A$ = N1$: GOSUB 2200: RETURN 
  49. 643  IF N2$ = ""  THEN  RETURN 
  50. 646  IF IX + LEN(N2$) +1 >FC  THEN  GOSUB 665: GOTO 649
  51. 648  IF   NOT J  THEN  PRINT " ";:IX = IX +1
  52. 649  PRINT N2$;:IX = IX + LEN(N2$)
  53. 650  RETURN 
  54. 652  IF   NOT OP(12)  OR N3$ = ""  THEN  RETURN 
  55. 655  IF IX + LEN(N3$) +1 >FC  THEN  GOSUB 665: GOTO 658
  56. 657  IF   NOT J  THEN  PRINT " ";:IX = IX +1
  57. 658  PRINT N3$;:IX = IX + LEN(N3$)
  58. 659  RETURN 
  59. 660  IF N4$ = ""  THEN  RETURN 
  60. 661  IF IX + LEN(N4$) +1 >FC  THEN  GOSUB 665: GOTO 664
  61. 663  PRINT " ";:IX = IX +1
  62. 664  PRINT N4$;:IX = IX + LEN(N4$): RETURN 
  63. 665  GOSUB 980:Y1 = Y1 +1:IX = 3 +(C1 = 2  AND FR <0) *TB +(FR = 0  AND IQ >0) *OP(13): GOSUB 595: PRINT  SPC( IX);: RETURN 
  64. 670 CZ =  PEEK( -16384): IF CZ <127  THEN 672
  65. 671  POKE  -16368,0: IF CZ =  ASC(CZ$) +128  THEN  RETURN 
  66. 672 CZ = 0: RETURN 
  67. 680  IF   NOT LA  AND IQ  THEN  GOSUB 598:LA = 1
  68. 681  RETURN 
  69. 686 A =  PEEK( -16384): IF A >127  THEN  POKE  -16368,0: IF A =  ASC(CZ$) +128  THEN XZ = Q(28)
  70. 688  RETURN 
  71. 690  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: IF  ASC(YN$) >95  THEN YN$ =  CHR$( ASC(YN$) -32)
  72. 691  RETURN 
  73. 692  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: RETURN 
  74. 694  IF   NOT OP(3)  THEN  RETURN 
  75. 695  IF OP(19)  THEN  RETURN 
  76. 696  IF IX +6 + LEN(RN$) >FC  THEN  GOSUB 665
  77. 697  PRINT " (NO "RN$")";:IX = IX +6 + LEN(RN$): RETURN 
  78. 700 TB = 0: IF IQ = 0  THEN  RETURN 
  79. 705  IF OP(17) > = 0  AND OP(17) <40  THEN TB = OP(17)
  80. 710  RETURN 
  81. 740  PRINT H$(C1): PRINT "BY "H1$(2):LO = 0:B$ = "FIRST ":X3 = LO +1
  82. 742  IF LO > = G(10)  THEN  PRINT "THE NUMBER LIST IS FULL": FOR I = 1 TO 2000: NEXT : GOTO 765
  83. 745  PRINT B$;: INPUT "NUMBER? ";A$: IF A$ = ""  THEN 765
  84. 750  IF A$ = CZ$  THEN LO = X3 -1: RETURN 
  85. 760 A =  VAL(A$):U = A: GOSUB 500: IF   NOT U  THEN 745
  86. 762 LO = LO +1:SV(LO) = A:B$ = "NEXT ": GOTO 742
  87. 765  IF LO <X3  THEN  RETURN 
  88. 767 CH = LO:LC = LO:CZ = 0: GOSUB 840: FOR XZ = X3 TO LO:X = SV(XZ)
  89. 780  GOSUB 7620: GOSUB 4700: IF CZ  OR YN$ = CZ$  THEN XZ = Q(28)
  90. 790  GOSUB 686: NEXT XZ:LO = CH: RETURN 
  91. 840  IF LO <1  THEN  PRINT : PRINT "NO LIST IN MEMORY": RETURN 
  92. 842  PRINT : PRINT "LIST=";: FOR I = 1 TO LO: PRINT SV(I);: IF I <LO  THEN  PRINT ",";
  93. 845  NEXT : PRINT : RETURN 
  94. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  95. 855  PRINT  CHR$(12): RETURN 
  96. 860  IF Q(22) <79  THEN  PRINT : RETURN 
  97. 861  PRINT " ";: RETURN 
  98. 865  IF Q(22) <79  THEN  PRINT "-"
  99. 866  RETURN 
  100. 880 V2$ = "": IF JR <1  OR   NOT OP(19)  OR W <1  THEN  RETURN 
  101. 882  FOR I = 1 TO JR: IF  VAL(F$(I)) = W  THEN  IF  LEN(F$(I)) > LEN( STR$(W)) +1  THEN V2$ =  RIGHT$(F$(I), LEN(F$(I)) - LEN( STR$(W)) -1):I = JR
  102. 884  NEXT : RETURN 
  103. 980  PRINT : GOSUB 608: RETURN 
  104. 990  PRINT  SPC( TB);: RETURN 
  105. 1000 CZ = 0: INPUT "START NUMBER? ";A$: IF A$ = ""  THEN  RETURN 
  106. 1010 X3 =  VAL(A$):U = X3: GOSUB 500: IF   NOT U  THEN 1000
  107. 1080  INPUT "END NUMBER? ";A$:X4 =  VAL(A$): IF X4 = 0  THEN X4 = X3
  108. 1090  IF A$ = CZ$  THEN  RETURN 
  109. 1095 U = X4: GOSUB 500: IF   NOT U  THEN 1080
  110. 1105  PRINT : PRINT H1$(1)": "X3;: IF X3 <X4  THEN  PRINT " TO ";X4;
  111. 1120  PRINT :CH = LO:LC = LO: FOR XZ = X3 TO X4:X = XZ: GOSUB 7620: GOSUB 4700: IF CZ  OR YN$ = CZ$  THEN XZ = Q(28)
  112. 1180  GOSUB 686: NEXT :LO = CH: RETURN 
  113. 1260  PRINT H$(C1)" HAVING ALL THE": PRINT "FOLLOWING-ENTERED NAMES IN COMMON:": PRINT  TAB( 5)"--LAST NAME AT BIRTH";: INPUT NL$
  114. 1265  PRINT  TAB( 5)"--FIRST NAME(S)";: INPUT NF$: PRINT  TAB( 5)"--MARRIED NAME";: INPUT NM$: PRINT : IF NF$ +NL$ +NM$ = ""  THEN  RETURN 
  115. 1270  INPUT "START NUMBER?";A$:X3 =  VAL(A$): IF X3 <1  THEN 1273
  116. 1271 U = X3: GOSUB 500: IF U  THEN 1280
  117. 1272  GOTO 1270
  118. 1273  IF A$ = CZ$  THEN  RETURN 
  119. 1274 A = Q(28): FOR I = 1 TO MP: IF WH(I,0) > -1  THEN  IF A >WH(I,0)  THEN A = WH(I,0)
  120. 1276  NEXT :X3 = A +1
  121. 1280  INPUT "END NUMBER?";A$:X4 =  VAL(A$): IF X4 <X3  THEN 1283
  122. 1281 U = X4: GOSUB 500: IF U  THEN 1400
  123. 1282  GOTO 1280
  124. 1283  IF A$ = CZ$  THEN  RETURN 
  125. 1284 X4 = X3 +ND -1: FOR J = 1 TO MP: FOR I = 1 TO MP: IF WH(I,0) = X4  THEN X4 = X4 +ND
  126. 1286  NEXT : NEXT 
  127. 1400 LO = LO *(Q(21) >0):CH = LO:LC = LO: GOSUB 1540: FOR XZ = X3 TO X4:CZ = 0:W = XZ: GOSUB 2600: GOSUB 300: IF NL$ = ""  THEN 1420
  128. 1410  IF NL$ < >N2$  THEN 1520
  129. 1420  IF NM$ = ""  THEN 1440
  130. 1430  IF NM$ < >N3$  THEN 1520
  131. 1440  IF NF$ = ""  THEN 1460
  132. 1450 Z = 0:AA$ = N1$:BB$ = NF$: GOSUB 7840: IF Z = 0  THEN 1520
  133. 1460 X = XZ: GOSUB 7620: IF CH <G(10)  THEN CH = CH +1:SV(CH) = X:LO = CH:LC = CH
  134. 1510  GOSUB 686: GOSUB 4700:LO = CH:LC = CH: GOSUB 1540
  135. 1520  GOSUB 686: NEXT XZ: RETURN 
  136. 1540  GOSUB 7100: PRINT : PRINT "SEARCHING FROM "X3" TO "X4" FOR";: GOSUB 860: PRINT "PEOPLE WITH THE FOLLOWING NAMES:": PRINT "'"NF$"' '"NL$"' '"NM$"'": PRINT : RETURN 
  137. 1600 SP = 2:T = 0:A = 0:K = 70: IF Q(43) <1  AND Q(40) = 0  AND Q(41) = 0  THEN K = 22
  138. 1602  GOSUB 1680:EP = SP + INT(.75 *Q(2)) -4: IF EP >OP +1  THEN EP = OP +1
  139. 1605  POKE 34,0: GOSUB 850: INVERSE : PRINT "SELECT PARAMETER BY LETTER:": NORMAL : PRINT : PRINT "A) FIRST VISIBLE PARAMETER" SPC( 6)"[NOW " CHR$(64 +SP)"]"
  140. 1610  FOR I = SP TO EP: PRINT  CHR$(64 *(I <27) +K *(I >26) +I)") ";
  141. 1611  PRINT OP$(I -1) SPC( 30 - LEN(OP$(I -1)) - LEN( STR$(OP(I -1))))"[NOW ";: IF TY(I -1)  THEN  PRINT  CHR$(78 *(OP(I -1) = 0) +89 *(OP(I -1) >0));: GOTO 1613
  142. 1612  PRINT OP(I -1);
  143. 1613  PRINT "]": IF 4 * INT((I -SP +2)/4) = I -SP +2  AND I < >EP  THEN  PRINT 
  144. 1614  NEXT :J = EP: IF DY$ < >""  AND EP = OP +1  THEN J = J +1: PRINT  CHR$(64 *(J <27) +K *(J >26) +J)") DATE" SPC( 26 - LEN(DY$))"[NOW "DY$"]"
  145. 1618 KK = OP +2: IF DY$ = ""  THEN KK = KK -1
  146. 1620  PRINT : IF KK <27  OR (Q(22) >39  AND (Q(40)  OR Q(41)))  THEN  INVERSE 
  147. 1625  PRINT "WHICH (A-"; CHR$(64 *(KK <27) +K *(KK >26) +KK);")?";: GOSUB 692
  148. 1626  IF YN$ =  CHR$(13)  THEN  RETURN 
  149. 1627  IF K = 22  THEN  IF  ASC(YN$) >48  AND  ASC(YN$) < = K +KK  THEN YN$ =  CHR$( ASC(YN$) +48)
  150. 1629  IF  ASC(YN$) >70 +KK  THEN YN$ =  CHR$( ASC(YN$) -32)
  151. 1630 A =  ASC(YN$) -64: IF  ASC(YN$) >96  THEN A =  ASC(YN$) -70
  152. 1631  IF A <1  OR A >KK  THEN 1620
  153. 1632  IF DY$ < >""  AND A = KK  THEN 1660
  154. 1635  IF A >1  THEN  PRINT OP$(A -1)"?";: GOTO 1640
  155. 1636  PRINT "FIRST VISIBLE PARAMETER?";: GOSUB 690:B$ = YN$: IF B$ =  CHR$(13)  THEN 1602
  156. 1637  IF B$ <"B"  THEN B$ = "B"
  157. 1638  IF B$ > CHR$(65 +OP)  THEN B$ =  CHR$(65 +OP)
  158. 1639 SP =  ASC(B$) -64: GOTO 1602
  159. 1640  IF   NOT TY(A -1)  THEN 1650
  160. 1645  GOSUB 690: IF YN$ =  CHR$(13)  THEN 1602
  161. 1648 OP(A -1) = (YN$ = "Y"  OR YN$ = "T"  OR YN$ = "1"): GOTO 1602
  162. 1650  INPUT " ";YN$: IF YN$ = ""  THEN 1602
  163. 1655 OP(A -1) =  VAL(YN$): GOTO 1602
  164. 1660  INPUT "DATE?";B$: IF B$ < >""  THEN DY$ = B$
  165. 1670  GOTO 1602
  166. 1680  IF OP(19)  THEN  IF   NOT Q(66)  THEN OP(19) = 0
  167. 1682  IF A -1 = 9  THEN T = 1
  168. 1685 OP(20) = 0:OP(21) = 0
  169. 1687  IF OP(2) >Q(20)  THEN OP(2) = Q(20)
  170. 1690  RETURN 
  171. 1900  POKE 216,0:K = 1:E$ = A$:A$ = "": RESUME 
  172. 2000 FM$ = "": IF A$ = ""  THEN 2045
  173. 2010 LB = 0: FOR I = 1 TO  LEN(A$): IF  MID$ (A$,I,1) = Q$(4)  THEN LB = I:I =  LEN(A$)
  174. 2020  NEXT : IF LB >0  THEN FM$ =  RIGHT$(A$, LEN(A$) -LB +1)
  175. 2030  IF LB >1  THEN A$ =  LEFT$(A$,LB -1)
  176. 2040  IF LB = 1  THEN A$ = ""
  177. 2045 K = 0: ONERR  GOTO 1900
  178. 2050 A =  VAL(A$): IF K  THEN A$ = E$
  179. 2055  ONERR  GOTO 16720
  180. 2060  RETURN 
  181. 2100  GOSUB 2000: GOTO 2120
  182. 2110  GOSUB 2000: GOTO 2130
  183. 2120  GOSUB 2200
  184. 2130  RETURN 
  185. 2200  GOSUB 2250: IF  LEN(A$) +IX < = FC  THEN 2230
  186. 2205  IF FC < = IX +1  THEN  GOSUB 665: IF  LEN(A$) +IX < = FC  THEN 2230
  187. 2210 FL = 0: FOR L = FC -IX TO 1  STEP  -1
  188. 2215  IF  MID$ (A$,L,1) = " "  OR  MID$ (A$,L,1) = ";"  OR  MID$ (A$,L,1) = "."  OR  MID$ (A$,L,1) = "-"  OR  MID$ (A$,L,1) = ","  THEN  PRINT  LEFT$(A$,L);:A$ =  RIGHT$(A$, LEN(A$) -L): GOSUB 665:L = 1:FL = 1
  189. 2220  NEXT : IF   NOT FL  THEN  PRINT  LEFT$(A$,FC -IX -1)"-";:A$ =  RIGHT$(A$, LEN(A$) -FC +IX +1): GOSUB 665
  190. 2225  IF  LEN(A$) +IX >FC  THEN 2205
  191. 2230  PRINT A$;:IX = IX + LEN(A$): RETURN 
  192. 2250  IF  LEFT$(A$,1) < >SP$  THEN 2260
  193. 2255  IF  LEN(A$) <2  THEN A$ = "": RETURN 
  194. 2257 A$ =  RIGHT$(A$, LEN(A$) -1): RETURN 
  195. 2260  IF  RIGHT$(A$,1) < >SP$  THEN 2270
  196. 2265  IF  LEN(A$) <2  THEN A$ = "": RETURN 
  197. 2267 A$ =  LEFT$(A$, LEN(A$) -1): RETURN 
  198. 2270  FOR I = 2 TO  LEN(A$): IF  MID$ (A$,I,1) = SP$  THEN A$ =  LEFT$(A$,I -1) + RIGHT$(A$, LEN(A$) -I):I =  LEN(A$)
  199. 2280  NEXT : RETURN 
  200. 2500 BB = 2: RETURN 
  201. 2600  IF W = 0  THEN  RETURN 
  202. 2610 IP =  -1: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN IP = I:I = Q(37)
  203. 2620  NEXT : IF IP > -1  THEN  RETURN 
  204. 2630 BB = Q(28): FOR I = 0 TO Q(37) -1: IF BB >SC(I)  THEN BB = SC(I):IP = I
  205. 2640  NEXT : GOSUB 2500
  206. 2800  IF FS < >BB  THEN  GOSUB 8650
  207. 2850  ONERR  GOTO 2910
  208. 2860  IF FS = 0  THEN  GOSUB 2896:ZN$ = PF$ +"NAMELIST." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZN$",S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38):FS = BB
  209. 2880 OB =  INT((W -WH(BB,0) -1)/Q(36)) +1: PRINT  CHR$(4)"READ"ZN$",R"OB: INPUT A: INPUT A:PA(IP) = (OB -1) *Q(36)
  210. 2885 II = 1:I = Q(36) *IP +1: CALL LI:NA$(I) =  MID$ (T$,1): IF NA$(I) < >""  THEN  IF  ASC(NA$(I)) = 34  THEN II = 2:NA$(I) =  MID$ (NA$(I),2)
  211. 2890  FOR I = I +1 TO Q(36) *(IP +1): CALL LI:NA$(I) =  MID$ (T$,II): NEXT : PRINT  CHR$(4):SC(IP) = 0:PA(IP) = PA(IP) +WH(BB,0):CT(IP) = PA(IP) +Q(36)
  212. 2895  RETURN 
  213. 2896  IF PF$ < >WH$(BB)  THEN PF$ = WH$(BB): PRINT  CHR$(4)"PREFIX"PF$",S"WH(BB,2)",D"WH(BB,3)
  214. 2897  RETURN 
  215. 2910  GOSUB 8650: GOSUB 7040: GOSUB 2896: PRINT  CHR$(4)"OPEN"ZN$",S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38): PRINT  CHR$(4)"READ"ZN$",R"OB:FS = BB: RESUME 
  216. 2950  IF A = 0  THEN  RETURN 
  217. 2960 BB =  -1: FOR I = 0 TO Q(37) -1: IF PA(I) <A  AND A < = PA(I) +Q(36)  THEN BB = I:I = Q(37)
  218. 2970  NEXT : IF BB > -1  THEN SC(BB) = SC(BB) +1
  219. 2980  RETURN 
  220. 4000  IF   NOT IQ  THEN TB = 0:V3$ = "":KL = Q(22): GOTO 4020
  221. 4005 KK = 0: FOR I = 1 TO Q(10): IF OP(8) <Q(I +31) +1  THEN KK = I:I = Q(10)
  222. 4010  NEXT : IF KK = 0  THEN KK = Q(10)
  223. 4015 V3$ = Q$(KK +7):KL = Q(23) *Q(KK +31)
  224. 4020 I = 4: IF OP(6)  AND OP(2) <4  THEN I = 3
  225. 4030  IF   NOT OP(6)  AND OP(2) >3  THEN I = 5
  226. 4050 FC = I * INT((KL +1)/I) -1:PB =  INT((FC -TB)/I): RETURN 
  227. 4200  IF   NOT IQ  THEN 4230
  228. 4205  GOSUB 595: IF Q(63)  THEN  FOR I = 1 TO Q(48) -Y1: PRINT : NEXT : GOTO 4220
  229. 4210  PRINT  CHR$(12)
  230. 4220  GOSUB 608: IF Q(64)  THEN  GOSUB 690
  231. 4230 Y1 = 0: RETURN 
  232. 4700 JR = 0:F$(1) = "":FR = 0:W = X: GOSUB 2600: IF C  THEN  GOSUB 300: GOTO 4725
  233. 4705  GOSUB 850: PRINT  LEFT$(H$(C1), LEN(H$(C1)) -1)" FOR":FC = Q(22):IX = 0:TT$ = "": GOSUB 610: PRINT :X5 = 0
  234. 4710  PRINT : INVERSE : PRINT "OK TO CONTINUE (Y/N/D/P/C)?";: GOSUB 690: IF YN$ = "N"  THEN  RETURN 
  235. 4711  GOSUB 8800: IF YN$ = "C"  THEN C = 1:YN$ = "Y"
  236. 4712  IF YN$ = CZ$  THEN XZ = Q(28): RETURN 
  237. 4715  IF YN$ = "D"  THEN  GOSUB 4000: GOSUB 6400: GOSUB 850:LA = 1: GOSUB 4800: PRINT : PRINT "PRESS ANY KEY TO CONTINUE";: GOSUB 690:LA = 0: RETURN 
  238. 4720  IF YN$ = "P"  THEN  GOSUB 1600: GOTO 4700
  239. 4725  GOSUB 6400: GOSUB 6900:IQ = 1: GOSUB 700: GOSUB 4000:LA = 1: GOSUB 590: GOSUB 4800: GOSUB 595: PRINT : PRINT Q$(Q(7)):Y1 = Y1 +2: GOSUB 608: IF OP(4)  THEN  GOSUB 4200
  240. 4735  GOSUB 600:IQ = 0:LA = 0:KN = 0: RETURN 
  241. 4800 DP$ = "":CP$ = "": FOR I = 1 TO PB -1:DP$ = DP$ +"-": NEXT : FOR I = 1 TO PB -3:CP$ = CP$ +" ": NEXT :GE = 3
  242. 4805 ID = 3: IF OP(6)  THEN ID = 2
  243. 4807  IF OP(9)  THEN CH$ =  STR$( VAL(CH$) +1)
  244. 4810  IF OP(14)  THEN  GOSUB 6600: IF   NOT OP(9)  THEN 4830
  245. 4820  GOSUB 595: PRINT : PRINT : PRINT  SPC( (IQ >0) *OP(13))V3$"CHART NO. "CH$: PRINT : PRINT : GOSUB 608:Y1 = Y1 +5
  246. 4830 X6 = 1: GOSUB 7200:Y1 = Y1 +3: IF   NOT OP(7)  THEN 4910
  247. 4840  IF LC < = LO  OR CZ  THEN 4910
  248. 4860 X = SV(LO +1): IF LC = LO +1  THEN 4880
  249. 4870  FOR I = LO +2 TO LC:SV(I -1) = SV(I): NEXT : IF CH >LC  THEN  FOR I = LC TO CH -1:SV(I -1) = SV(I): NEXT 
  250. 4880 LC = LC -1: IF CH >LC  THEN CH = CH -1
  251. 4885  IF OP(4)  THEN  GOSUB 4200
  252. 4890  IF X <1  THEN 4840
  253. 4895  IF OP(9)  THEN CH$ =  STR$( VAL(CH$) +1)
  254. 4900 JR = 0: GOTO 4810
  255. 4910  RETURN 
  256. 4920 W = X: GOSUB 8900: GOSUB 5600: IF X6 >1  THEN  GOSUB 680: GOSUB 595
  257. 4930  ON X6 GOSUB 5000,5020,5040,5060,5080,5100,5120,5140,5160,5180,5200,5220,5240,5260,5280
  258. 4940 Y1 = Y1 +3:X6 = X6 +1: RETURN 
  259. 5000  GOSUB 6000: GOSUB 680: GOSUB 595:A = ID *PB +1: GOSUB 990: PRINT  SPC( A)V1$;: GOSUB 5400: PRINT 
  260. 5010  GOSUB 990: PRINT  SPC( A)Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A -1)".";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 608: RETURN 
  261. 5020 A = (ID -1) *PB +1: GOSUB 990: PRINT  SPC( A)V1$V$"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)Z$V$"M "D$;: GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A -1)"."DP$V$;: GOSUB 5320: PRINT : GOSUB 6000: RETURN 
  262. 5040 A = (ID -1) *PB: GOSUB 990: PRINT  SPC( A)V$"B "B$V$V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A);
  263. 5050  PRINT V$"M "D$V$Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A)V$;: GOSUB 5320: PRINT "'";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  264. 5060 A = (ID -2) *PB +1: GOSUB 990: PRINT  SPC( A)V1$V$ SPC( PB)"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)Z$V$ SPC( PB);: GOSUB 5350
  265. 5070  GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A -1)"."DP$V$ SPC( PB);: GOSUB 5360: PRINT : GOSUB 6000: RETURN 
  266. 5080 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$"B "B$V$ SPC( PB)V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A)V$"M "D$V$ SPC( PB)Z$;: GOSUB 5410: PRINT 
  267. 5090  GOSUB 990: PRINT  SPC( A)V$;: GOSUB 5320: PRINT V$ SPC( PB -1)".";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  268. 5100 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)V$V1$V$"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)V$Z$V$"M "D$;: GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)"'"DP$V$;
  269. 5110  GOSUB 5320: PRINT : GOSUB 6000: RETURN 
  270. 5120 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$ SPC( PB)"B "B$V$V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB);: GOSUB 5350
  271. 5130  PRINT V$Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB);: GOSUB 5360: PRINT "'";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  272. 5140  IF ID = 2  THEN A$ = V$:E$ = " "
  273. 5141  IF ID = 3  THEN A$ = " ":E$ = V$
  274. 5145 A = (ID -1) *PB: GOSUB 990: PRINT A$V1$E$ SPC( A)"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT A$Z$E$ SPC( A);: GOSUB 5350
  275. 5150  GOSUB 5440: PRINT : GOSUB 990: PRINT A$DP$E$ SPC( A);: GOSUB 5360: PRINT : GOSUB 6000: RETURN 
  276. 5160  IF ID = 2  THEN A$ = V$:E$ = " "
  277. 5165  IF ID = 3  THEN A$ = " ":E$ = V$
  278. 5170  GOSUB 680:A = (ID -1) *PB: GOSUB 990: PRINT A$"B "B$E$ SPC( A)V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT A$"M "D$E$ SPC( A)Z$;: GOSUB 5410: PRINT 
  279. 5175  GOSUB 990: PRINT A$;: GOSUB 5320: PRINT E$ SPC( A -1)".";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  280. 5180 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$ SPC( PB)V1$V$"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB)Z$V$"M "D$;: GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)"."DP$V$;: GOSUB 5320: PRINT : GOSUB 6000: RETURN 
  281. 5200 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)V$"B "B$V$V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)V$"M "D$V$Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A)V$ SPC( PB -1)V$;: GOSUB 5320
  282. 5210  PRINT "'";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  283. 5220 A = (ID -2) *PB: GOSUB 990: PRINT  SPC( A)V$V1$V$ SPC( PB)"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)V$Z$V$ SPC( PB);: GOSUB 5350
  284. 5230  GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A)"'"DP$V$ SPC( PB);: GOSUB 5360: PRINT : GOSUB 6000: RETURN 
  285. 5240 A = (ID -2) *PB +1: GOSUB 990: PRINT  SPC( A)"B "B$V$ SPC( PB)V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5350
  286. 5250  PRINT V$ SPC( PB)Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5360: PRINT V$ SPC( PB -1)".";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000: RETURN 
  287. 5260 A = (ID -1) *PB: GOSUB 990: PRINT  SPC( A)V$V1$V$"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A)V$Z$V$"M "D$;: GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A)"'"DP$V$;: GOSUB 5320: PRINT : GOSUB 6000: RETURN 
  288. 5280 A = (ID -1) *PB +1: GOSUB 990: PRINT  SPC( A)"B "B$V$V1$;: GOSUB 5400: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5350
  289. 5290  PRINT V$Z$;: GOSUB 5410: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5360: PRINT "'";: GOSUB 5370: GOSUB 5420: PRINT : GOSUB 6000
  290. 5300 X6 = 16: GOSUB 5950: GOSUB 680: GOSUB 595:A = ID *PB +1: GOSUB 990: PRINT  SPC( A)"B "B$;: GOSUB 5430: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5350
  291. 5315  GOSUB 5440: PRINT : GOSUB 990: PRINT  SPC( A);: GOSUB 5360: GOSUB 980: RETURN 
  292. 5320  IF  LEFT$(TT$,4) = "Livi"  THEN  PRINT TT$"  ";: RETURN 
  293. 5340  PRINT "D "TT$;: RETURN 
  294. 5350  IF OP(24)  THEN  GOSUB 5320: RETURN 
  295. 5355  PRINT "M "D$;: RETURN 
  296. 5360  IF OP(24)  THEN  PRINT CP$"  ";: RETURN 
  297. 5365  GOSUB 5320: RETURN 
  298. 5370  IF OP(2) >3  THEN 5395
  299. 5375  IF   NOT OP(9)  OR   NOT R  THEN 5395
  300. 5380 CI$ =  STR$( VAL(CI$) +1): IF  LEN(DP$) < =  LEN(CI$) +3  THEN 5395
  301. 5385  PRINT  LEFT$(DP$, LEN(DP$) - LEN(CI$) -1)">"CI$;: RETURN 
  302. 5395  PRINT DP$;: RETURN 
  303. 5400  IF OP(2) >3  THEN  PRINT " "Y$;
  304. 5405  RETURN 
  305. 5410  IF OP(2) >3  THEN  PRINT ".";: GOSUB 5375
  306. 5415  RETURN 
  307. 5420  IF OP(2) >3  THEN  PRINT V$;
  308. 5425  RETURN 
  309. 5430  IF OP(2) >3  THEN  PRINT V$Y$;
  310. 5435  RETURN 
  311. 5440  IF OP(2) >3  THEN  PRINT "'";: GOSUB 5375
  312. 5445  RETURN 
  313. 5600  GOSUB 5950:W = X: IF W >0  THEN 5620
  314. 5610 Z$ = S$(OD(AA),AA): IF  LEN(Z$) <2  OR   NOT Z1  THEN Z$ = ""
  315. 5620 C2 = 0: GOSUB 5630: RETURN 
  316. 5630  IF W = 0  THEN 5730
  317. 5635 Z$ = "": IF   NOT OP(3)  THEN 5660
  318. 5640  IF   NOT OP(19)  THEN Z$ =  STR$(W) +" ": GOTO 5660
  319. 5650  GOSUB 880: IF V2$ < >""  THEN Z$ = V2$ +" "
  320. 5660  GOSUB 2600: GOSUB 300:X2 =  LEN(N1$) + LEN(N2$) + LEN(N4$): IF OP(12)  THEN X2 = X2 + LEN(N3$)
  321. 5670 Z2 = 1: IF X2 >2 *PB -2  THEN Z2 = 0
  322. 5680 J = 0: IF   NOT OP(10)  THEN  GOSUB 5840: GOSUB 5890: GOSUB 5920: GOTO 5720
  323. 5690  IF OP(12)  AND N3$ < >""  THEN 5710
  324. 5700 J = 1: GOSUB 5890:J = 0:Z$ = Z$ +", ": GOSUB 5840: GOTO 5720
  325. 5710 J = 1: GOSUB 5920:J = 0:Z$ = Z$ +", ": GOSUB 5840: GOSUB 5890
  326. 5720  IF N4$ < >""  THEN Z$ = Z$ +" " +N4$
  327. 5730 Z2 = 2 *PB -2: IF  LEN(Z$) > = Z2  THEN 5790
  328. 5740  IF  LEN(Z$) < = PB -1  THEN 5780
  329. 5750  FOR I = PB TO 1  STEP  -1: IF  MID$ (Z$,I,1) = " "  THEN J = I:I = 1
  330. 5760  NEXT : IF C2  THEN 5795
  331. 5765  IF J <2  OR  LEN(Z$) -J >PB -1  OR  LEN(Z$) = J  THEN A = 2 *PB -2: GOSUB 5800: GOTO 5790
  332. 5770 V1$ =  LEFT$(Z$,J -1):Z$ =  RIGHT$(Z$, LEN(Z$) -J):A = PB -1: GOSUB 5800: GOSUB 5820: RETURN 
  333. 5780 V1$ = CP$ +"  ":A = PB -1: GOSUB 5800: RETURN 
  334. 5790 V1$ =  LEFT$(Z$,Z2/2):Z$ =  MID$ (Z$,Z2/2 +1,Z2/2): RETURN 
  335. 5795  IF  LEN(Z$) = J  OR  LEN(Z$) -J > = PB -2  THEN Z$ =  RIGHT$(Z$,PB -1): RETURN 
  336. 5796  FOR I =  LEN(Z$) TO 1  STEP  -1: IF  MID$ (Z$,I,1) = " "  THEN J = I:I = 1
  337. 5797  NEXT : IF PB -2 > LEN(Z$) -J  THEN Z$ =  LEFT$(Z$,PB -2 - LEN(Z$) +J) + MID$ (Z$,J): RETURN 
  338. 5798  GOTO 5795
  339. 5800  IF A > LEN(Z$)  THEN  FOR I = 1 TO A - LEN(Z$):Z$ = Z$ +" ": NEXT 
  340. 5810  RETURN 
  341. 5820  IF A > LEN(V1$)  THEN  FOR I = 1 TO A - LEN(V1$):V1$ = V1$ +" ": NEXT 
  342. 5830  RETURN 
  343. 5840  IF N1$ = ""  THEN  RETURN 
  344. 5850  IF Z2  THEN Z$ = Z$ +N1$: RETURN 
  345. 5860 Z = 0: FOR II = 1 TO  LEN(N1$): IF  MID$ (N1$,II,1) <"A"  OR  MID$ (N1$,II,1) >"Z"  THEN Z = II -1:II =  LEN(N1$)
  346. 5870  NEXT : IF Z = 0  THEN Z =  LEN(N1$)
  347. 5880 Z$ = Z$ + LEFT$(N1$,Z): RETURN 
  348. 5890  IF N2$ = ""  THEN  RETURN 
  349. 5900  IF   NOT J  THEN Z$ = Z$ +" "
  350. 5910 Z$ = Z$ +N2$: RETURN 
  351. 5920  IF   NOT OP(12)  OR N3$ = ""  THEN  RETURN 
  352. 5930  IF   NOT J  THEN Z$ = Z$ +" "
  353. 5940 Z$ = Z$ +N3$: RETURN 
  354. 5950  IF OP(2) <4  THEN  RETURN 
  355. 5952  IF  INT(X6/2) *2 = X6  THEN Y$ = LT$:R = DR: RETURN 
  356. 5955  IF X = 0  THEN LT$ = "":Y$ = "":DR = 0: RETURN 
  357. 5960 C2 = 1:A$ = RC$(7): GOSUB 2000:W = A:Z$ = A$: GOSUB 7500:DR = R: GOSUB 5630:Y$ = Z$:A$ = RC$(6): GOSUB 2000:W = A:Z$ = A$: GOSUB 7500: GOSUB 5630:LT$ = Z$:I = R:R = DR:DR = I: RETURN 
  358. 6000  GOSUB 608: IF   NOT X7  THEN B$ = CP$:D$ = CP$:TT$ = CP$: RETURN 
  359. 6010 A$ = RC$(1): IF A$ = ""  THEN  IF G(12) >0  AND OP(11)  THEN A$ = RC$(G(12))
  360. 6020  GOSUB 2000:AA$ = A$: GOSUB 7980: IF PB - LEN(BB$) <13  THEN 6050
  361. 6030 A$ = RC$(2): IF A$ = ""  THEN  IF G(12) >0  AND OP(11)  THEN  IF FP(G(12)) >0  THEN A$ = RC$(FP(G(12)))
  362. 6040  GOSUB 2000:BB$ = BB$ +" " +A$
  363. 6050  GOSUB 6360:B$ = BB$
  364. 6060 BB$ = "": IF MG = 0  THEN 6210
  365. 6070  IF MG = 1  THEN X2 = 1: GOTO 6200
  366. 6075  IF AA >1  THEN 6150
  367. 6100  IF   NOT OP(25)  THEN 6210
  368. 6110  GOSUB 605:EP = IQ:IQ = 0:LA = 0:X2 = 0:SP = FC:FC = Q(22): PRINT :W = X:IX = 0: GOSUB 2600: GOSUB 610: GOSUB 860: PRINT "HAS MORE THAN 1 MARRIAGE.": PRINT "THE MARRIAGE DATA FOR WHICH OF THE FOL";: GOSUB 865: PRINT "LOWING SPOUSES SHOULD BE USED:": PRINT 
  369. 6115  FOR X8 = 1 TO MG:A$ = MI$(1,X8): GOSUB 2000:W = A: GOSUB 2600: PRINT X8") ";:IX = 3: IF A = 0  THEN  GOSUB 2200: GOTO 6130
  370. 6120  GOSUB 610
  371. 6130  PRINT : NEXT 
  372. 6131  PRINT : INVERSE : PRINT "CHOICE (1-"MG;: INPUT ")?";YN$: NORMAL : IF YN$ = ""  THEN X2 = 1: GOTO 6140
  373. 6133  IF YN$ = CZ$  THEN 20000
  374. 6136 X2 =  VAL(YN$): IF X2 <1  OR X2 >MG  THEN 6131
  375. 6140 FC = SP:IQ = EP: GOTO 6200
  376. 6150 Y = X:X2 = 0:SP = MG: FOR X8 = 1 TO SP:A$ = MI$(1,X8): GOSUB 2000:X9 = A:D$ = A$
  377. 6160 X =  VAL(S$(OD(AA -1),AA -1)): GOSUB 7620: GOSUB 6300
  378. 6170 X =  VAL(S$(OD(AA -2),AA -2)): GOSUB 7620: GOSUB 6300
  379. 6180 X = Y: GOSUB 7620
  380. 6190  NEXT 
  381. 6200  IF X2 >0  THEN A$ = MI$(2,X2): GOSUB 2000:AA$ = A$: GOSUB 7980: IF PB - LEN(BB$) >12  THEN A$ = MI$(3,X2): GOSUB 2000:BB$ = BB$ +" " +A$
  382. 6210  GOSUB 6360:D$ = BB$
  383. 6220 A$ = RC$(3): IF A$ = ""  THEN  IF G(11) >0  AND OP(11)  THEN A$ = RC$(G(11))
  384. 6230  GOSUB 2000:AA$ = A$: GOSUB 7980: IF BB$ < >"L"  THEN 6260
  385. 6240 BB$ = "Living": IF PB - LEN(BB$) <13  OR RC$(4) = ""  THEN 6290
  386. 6250  GOSUB 8100:BB$ = BB$ +" " +A$: GOTO 6290
  387. 6260  IF PB - LEN(BB$) <13  THEN 6290
  388. 6270 A$ = RC$(4): IF A$ = ""  THEN  IF G(11) >0  AND OP(11)  THEN  IF FP(G(11)) >0  THEN A$ = RC$(FP(G(11)))
  389. 6280  GOSUB 2000:BB$ = BB$ +" " +A$
  390. 6290  GOSUB 6360:TT$ = BB$: RETURN 
  391. 6300 A$ = RC$(6): GOSUB 2000: IF X9 >0  THEN  IF A = X9  THEN 6350
  392. 6310  IF X9 = 0  THEN  GOSUB 8600: IF A >.8  THEN 6350
  393. 6320 A$ = RC$(7): GOSUB 2000: IF X9 >0  THEN  IF A = X9  THEN 6350
  394. 6330  IF X9 = 0  THEN  GOSUB 8600: IF A >.8  THEN 6350
  395. 6340  RETURN 
  396. 6350 X2 = X8:X8 = SP: RETURN 
  397. 6360  IF  LEN(BB$) <PB -3  THEN  FOR II = 1 TO PB -3 - LEN(BB$):BB$ = BB$ +" ": NEXT 
  398. 6370  IF  LEN(BB$) >PB -3  THEN BB$ =  LEFT$(BB$,PB -3)
  399. 6380  RETURN 
  400. 6400  IF   NOT OP(14)  THEN  RETURN 
  401. 6401  IF HL >0  THEN  IF OP(18)  THEN  RETURN 
  402. 6402  GOSUB 850: PRINT H$(C1): PRINT : PRINT : INVERSE : PRINT "DEFINING HEADER:": NORMAL : PRINT : POKE 34,5
  403. 6403  IF HL <1  THEN 6410
  404. 6404  PRINT "USE PREVIOUSLY DEFINED HEADER (Y/N/D/E)?";: GOSUB 690: PRINT :OP(14) = (YN$ < >CZ$): IF YN$ = "Y"  OR YN$ = CZ$  THEN  POKE 34,0: RETURN 
  405. 6406  IF YN$ = "D"  THEN  GOSUB 6560: GOTO 6404
  406. 6408  IF YN$ = "E"  THEN  GOSUB 6560: GOTO 6515
  407. 6410 HL = 0: INPUT "HOW MANY BLANK LINES AT THE TOP?";YN$: IF YN$ = ""  THEN 6450
  408. 6420 HL =  VAL(YN$): IF HL <0  THEN HL = 0
  409. 6430  IF HL >Q(18) -2  THEN 6410
  410. 6440  IF HL >0  THEN  FOR I = 1 TO HL:G$(I) = "": NEXT 
  411. 6450  PRINT : PRINT "TYPE UP TO "Q(18) -HL" LINES (" CHR$(65 +HL)" THROUGH " CHR$(64 +Q(18))").  USE";: GOSUB 860: PRINT "'RETURN' TO END:"
  412. 6460  PRINT :HL = HL +1: PRINT "LINE " CHR$(64 +HL)": ";: CALL LI:G$(HL) =  MID$ (T$,1): IF G$(HL) < >""  AND HL <Q(18) -1  THEN 6460
  413. 6470 HL = HL -1: PRINT : INPUT "HOW MANY BLANK LINES TO FOLLOW?";YN$: IF YN$ = ""  THEN HL = HL +1:G$(HL) = "": GOTO 6510
  414. 6480 A =  VAL(YN$): IF A <0  THEN 6510
  415. 6490  IF A > = Q(18) -HL  THEN A = Q(18) -HL -1
  416. 6500  IF A >0  THEN  FOR I = HL +1 TO HL +A:G$(I) = "": NEXT :HL = HL +A
  417. 6510  GOSUB 6560: PRINT : PRINT "IS IT O.K. (Y/N/E)?";: GOSUB 690: IF YN$ = "N"  THEN  GOSUB 850: GOTO 6410
  418. 6511  IF YN$ = CZ$  THEN 20000
  419. 6512  IF YN$ =  CHR$(13)  OR YN$ = "Y"  THEN 6530
  420. 6514  IF YN$ < >"E"  THEN 6510
  421. 6515  PRINT : PRINT "REENTER WHICH LINE (A-" CHR$(64 +HL)"/Z)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN 6530
  422. 6516  IF YN$ = CZ$  THEN 20000
  423. 6518  IF YN$ = "Z"  THEN  GOSUB 850: GOTO 6410
  424. 6520 A =  ASC(YN$) -64: IF A <1  OR A >HL  THEN 6515
  425. 6525  PRINT : PRINT "LINE " CHR$(64 +A)": ";: CALL LI:G$(A) =  MID$ (T$,1): GOTO 6510
  426. 6530  PRINT : PRINT "DO YOU WANT TO SET ANY PARAMETERS";: GOSUB 860: PRINT "BEFORE STARTING (Y/N)?";: GOSUB 690: POKE 34,0: IF YN$ = "Y"  OR YN$ = "P"  THEN  GOSUB 1600
  427. 6540  RETURN 
  428. 6560  GOSUB 850: PRINT "YOUR HEADER IS:": PRINT : FOR X5 = 1 TO HL: PRINT "LINE " CHR$(64 +X5)": ";:IX = 7: GOSUB 6610: NEXT : RETURN 
  429. 6600  IF HL = 0  THEN  RETURN 
  430. 6605  GOSUB 595: FOR X5 = 1 TO HL: PRINT  SPC( OP(13))V3$;:IX = OP(12):Y1 = Y1 +1: GOSUB 6610: NEXT : GOSUB 608: RETURN 
  431. 6610  IF G$(X5) = "*"  THEN  PRINT DY$: RETURN 
  432. 6620  IF  LEN(G$(X5)) +IX < = FC  THEN  PRINT G$(X5): RETURN 
  433. 6630 J = 0: FOR I = FC -IX TO 1  STEP  -1: IF  MID$ (G$(X5),I,1) = " "  OR  MID$ (G$(X5),I,1) = "-"  THEN J = I:I = 1
  434. 6635  NEXT : IF J  AND J < LEN(G$(X5))  THEN  PRINT  LEFT$(G$(X5),J): PRINT  SPC( IX +2) RIGHT$(G$(X5), LEN(G$(X5)) -J):Y1 = Y1 +1: RETURN 
  435. 6640  PRINT G$(X5): RETURN 
  436. 6760  GOSUB 850: PRINT : PRINT "A) RUN A DIFFERENT PROGRAM": PRINT "B) CHECK FREE SPACE": PRINT "C) RETURN TO 'STANDARDS'": PRINT "D) END SESSION"
  437. 6762  PRINT : INVERSE : PRINT "CHOICE (A-D)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  GOTO 6780
  438. 6763 C1 =  ASC(YN$) -64: IF C1 <1  OR C1 >4  THEN 6762
  439. 6764  IF C1 = 4  THEN  GOSUB 850: PRINT Q$(21): PRINT "BYE...": END 
  440. 6768  ON C1 GOTO 6780,6770,20000
  441. 6770  PRINT "FREE SPACE="; FRE(0): GOSUB 690: GOTO 6760
  442. 6780  GOSUB 6792: IF CZ  THEN 6760
  443. 6785  GOSUB 7100: PRINT "LOADING NEXT MODULE": ONERR  GOTO 16720
  444. 6788  PRINT  CHR$(4)"PREFIX,S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"PREFIX": INPUT PF$:A$ = ME$(WH(BB,1)): IF  LEFT$(A$, LEN(PF$)) = PF$  THEN PF$ = A$: PRINT  CHR$(4)"PREFIX"PF$
  445. 6790  PRINT  CHR$(4)"RUNPROGRAMS"
  446. 6792 CZ = 0:BB =  -1: IF WH(LD,0) =  -3  THEN BB = LD: RETURN 
  447. 6793  FOR I = 1 TO MP: IF WH(I,0) =  -3  THEN BB = I:LD = I:I = MP
  448. 6794  NEXT : IF BB >0  THEN  RETURN 
  449. 6795 BB = Q(29): PRINT : PRINT "CAN'T FIND PROGRAM DISK";: GOSUB 690:CZ = 1: RETURN 
  450. 6900  RETURN 
  451. 7000  GOSUB 8660: GOSUB 7040: GOSUB 2896: PRINT  CHR$(4)"OPEN"ZF$",L"Q(16)",S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"READ"ZF$",R"X -WH(BB,0):FF = BB: RESUME 
  452. 7040  POKE 216,0:A =  PEEK(222): IF A < >6  OR ME(WH(BB,1),1) <0  THEN 16720
  453. 7050  GOSUB 605:LA = 0: PRINT "LOAD DATA DISK NUMBER "WH(BB,4)" INTO DRIVE "WH(BB,1)". ";: GOSUB 860: PRINT "PRESS ANY KEY WHEN READY";: GOSUB 690: IF YN$ = CZ$  THEN 20000
  454. 7070  RETURN 
  455. 7100  GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "...": PRINT : PRINT  SPC( 14);: RETURN 
  456. 7200 AA = 1
  457. 7210 S$(1,0) =  STR$(X):OD(0) = 1
  458. 7220  GOSUB 670: IF CZ >0  THEN  RETURN 
  459. 7230  GOSUB 7620
  460. 7240 A$ = RC$(7): GOSUB 2000:S$(1,AA) = A$: GOSUB 2950:A$ = RC$(6): GOSUB 2000:S$(2,AA) = A$: GOSUB 2950:OD(AA) = 1
  461. 7250 X =  VAL(S$(OD(AA),AA)): IF X >0  THEN 7330
  462. 7270 X7 = 0:R = 0: IF AA = 3  THEN FL = 1
  463. 7280  IF AA = 2  THEN FL = 3
  464. 7290  IF AA = 1  THEN FL = 7
  465. 7300  FOR II = 4 TO AA +1  STEP  -1:S$(1,II) = "":S$(2,II) = "": NEXT 
  466. 7310  FOR X1 = 1 TO FL:Z1 = 0: IF X1 = (FL +1)/2  THEN Z1 = 1
  467. 7320  GOSUB 4920: NEXT : GOTO 7430
  468. 7330  GOSUB 670: IF CZ >0  THEN  RETURN 
  469. 7340 AA = AA +1: IF AA <GE +1  THEN 7220
  470. 7350  GOSUB 7620: IF OP(2) <4  THEN R = 0: IF RC$(6) < >""  OR RC$(7) < >""  THEN W = X: GOSUB 7500
  471. 7370 AA = AA -1:X7 = 1:Z1 = 1: GOSUB 4920
  472. 7380  GOSUB 670: IF CZ >0  THEN  RETURN 
  473. 7430 X =  VAL(S$(OD(AA -1),AA -1)):X7 = 1: IF OD(AA) = 1  THEN  GOSUB 7620:Z1 = 1: GOSUB 4920
  474. 7440 OD(AA) = OD(AA) +1: IF OD(AA) < = 2  THEN 7250
  475. 7450 AA = AA -1: IF AA >0  THEN 7380
  476. 7460  RETURN 
  477. 7500 R = 0: IF   NOT OP(7)  OR LC > = G(10)  OR W <1  THEN  RETURN 
  478. 7510 R = W:LC = LC +1:SV(LC) = W: RETURN 
  479. 7620 W = X: GOSUB 2500
  480. 7630  IF FF < >BB  THEN  GOSUB 8660
  481. 7635  ONERR  GOTO 7000
  482. 7640  IF FF = 0  THEN  GOSUB 2896:ZF$ = PF$ +"FAMILY." + STR$(WH(BB,4)): PRINT  CHR$(4)"OPEN"ZF$",L"Q(16)",S"WH(BB,2)",D"WH(BB,3):FF = BB
  483. 7660  PRINT  CHR$(4)"READ"ZF$",R"X -WH(BB,0)
  484. 7670 II = 1: CALL LI:RC$(1) =  MID$ (T$,1): IF RC$(1) < >""  THEN  IF  ASC(RC$(1)) = 34  THEN II = 2:RC$(1) =  MID$ (RC$(1),2)
  485. 7680  FOR I = 2 TO 10: CALL LI:RC$(I) =  MID$ (T$,II): NEXT 
  486. 7700 A$ = RC$(8): GOSUB 2000:MG = A: IF MG >0  THEN  FOR I = 1 TO MG: FOR J = 1 TO 4: CALL LI:MI$(J,I) =  MID$ (T$,II): NEXT : NEXT 
  487. 7740 A$ = RC$(9): GOSUB 2000:CN = A: IF CN >0  THEN  FOR I = 1 TO CN: CALL LI:C$(I) =  MID$ (T$,II): NEXT 
  488. 7770 A$ = RC$(10): GOSUB 2000:NT = A: IF NT >0  THEN  FOR I = 1 TO NT: CALL LI:EX$(I) =  MID$ (T$,II): NEXT 
  489. 7775  FOR I = 11 TO 20: CALL LI:RC$(I) =  MID$ (T$,II): NEXT 
  490. 7780  PRINT  CHR$(4): POKE 216,0
  491. 7785  IF MG = 0  THEN  FOR I = 1 TO Q(19): FOR J = 1 TO 4:MI$(J,I) = "": NEXT : NEXT 
  492. 7790  IF CN = 0  THEN  FOR I = 1 TO Q(18):C$(I) = "": NEXT 
  493. 7795  IF NT = 0  THEN  FOR I = 1 TO Q(17):EX$(I) = "": NEXT 
  494. 7800  RETURN 
  495. 7840 A =  LEN(AA$) - LEN(BB$)
  496. 7860  IF A <0  THEN Z = 0: RETURN 
  497. 7880 II = A +1
  498. 7900  IF BB$ =  MID$ (AA$,II, LEN(BB$))  THEN Z = II
  499. 7920 II = II -1: IF II >0  THEN 7900
  500. 7940  RETURN 
  501. 7980 BB$ = AA$:A =  LEN(AA$): IF  LEN(AA$) >7  THEN 7985
  502. 7982 A$ = BB$: GOSUB 2000:BB$ = A$
  503. 7983  RETURN 
  504. 7985  IF A >8  AND  MID$ (AA$,9,1) < >Q$(4)  THEN  RETURN 
  505. 7987  IF  LEFT$(AA$,1) < >"?"  AND  LEFT$(AA$,1) < >"-"  THEN JJ =  VAL( LEFT$(AA$,2)): IF JJ <1  OR JJ >31  THEN  RETURN 
  506. 7990 BB$ = "":I = 0: FOR II = 1 TO 8: IF  MID$ (AA$,II,1) = " "  THEN II = 8:I = 0: GOTO 7995
  507. 7992  IF  MID$ (AA$,II,1) > = "0"  AND  MID$ (AA$,II,1) < = "9"  THEN I = 1
  508. 7995  NEXT : IF I = 0  THEN  RETURN 
  509. 7996  IF A <10  THEN 8000
  510. 7997  IF DP$ = ""  OR   NOT OP(11)  OR  RIGHT$(AA$,A -9) <"1"  OR  RIGHT$(AA$,A -9) >"9"  THEN BB$ =  RIGHT$(AA$,A -8): GOTO 8000
  511. 7999  IF  VAL( MID$ (DP$, ABS( VAL( RIGHT$(AA$,A -9))) +1,1))  THEN BB$ =  RIGHT$(AA$,A -8)
  512. 8000  IF   NOT OP(1)  THEN 8018
  513. 8005  IF   NOT Q(25)  THEN IP =  VAL( LEFT$(AA$,2))
  514. 8007  IF Q(25)  THEN IP =  VAL( MID$ (AA$,3,2))
  515. 8010  IF IP <1  OR IP >12  THEN 8018
  516. 8012  IF   NOT Q(25)  THEN BB$ =  MID$ (AA$,3,2) +" " +MT$(IP) +" " + MID$ (AA$,5,4) +BB$: RETURN 
  517. 8014  IF Q(25)  THEN BB$ =  LEFT$(AA$,2) +" " +MT$(IP) +" " + MID$ (AA$,5,4) +BB$: RETURN 
  518. 8018 BB$ =  LEFT$(AA$,2) +"/" + MID$ (AA$,3,2) +"/" + MID$ (AA$,5,4) +BB$: RETURN 
  519. 8100 A$ = RC$(4): GOSUB 2000: IF OP(22)  OR A$ = ""  THEN  RETURN 
  520. 8105 OD = 0:OB =  LEN(A$): FOR JJ = OB TO 1  STEP  -1: IF  MID$ (A$,JJ,1) = ";"  THEN OD = JJ -1:JJ = 1
  521. 8110  NEXT : IF OD <1  THEN  RETURN 
  522. 8120 X8 = 1: FOR JJ = OD TO 1  STEP  -1: IF  MID$ (A$,JJ,1) = ";"  THEN X8 = JJ +1:JJ = 1
  523. 8130  IF  MID$ (A$,JJ,1) = SP$  THEN OD = JJ
  524. 8140  NEXT :A$ =  MID$ (A$,X8,OD -X8 +1): RETURN 
  525. 8600 A = 0: IF A$ = ""  OR D$ = ""  THEN  RETURN 
  526. 8610  FOR I = 1 TO  LEN(D$): FOR J = 1 TO  LEN(A$): IF  MID$ (A$,J,1) =  MID$ (D$,I,1)  THEN A = A +1:J = 255
  527. 8620  NEXT : NEXT :A = A/ LEN(D$): RETURN 
  528. 8650 FS = 0: IF ZN$ < >""  THEN  PRINT  CHR$(4)"CLOSE"ZN$
  529. 8655  RETURN 
  530. 8660 FF = 0: IF ZF$ < >""  THEN  PRINT  CHR$(4)"CLOSE"ZF$
  531. 8665  RETURN 
  532. 8800  IF OP(9)  AND T  THEN CH$ =  STR$(OP(5) -1):T = 0:CI$ =  STR$(OP(5))
  533. 8810  RETURN 
  534. 8900  IF   NOT OP(19)  OR X <1  THEN  RETURN 
  535. 8905  IF  VAL(F$(1)) = X  THEN  RETURN 
  536. 8910 X9 = 1:JR = 1:F$(1) =  STR$(X) +CZ$ +RC$(Q(66)): IF C1 = 2  OR AA <3  THEN  RETURN 
  537. 8915 Y = X: FOR EP = 6 TO 7:A$ = RC$(EP): GOSUB 2000: IF A >0  THEN X = A: GOSUB 7620:JR = JR +1:F$(JR) =  STR$(X) +CZ$ +RC$(Q(66)):X = Y: GOSUB 7620
  538. 8940  NEXT : RETURN 
  539. 9000  DATA 3
  540. 9020  DATA PRINT STANDARD PEDIGREE CHARTS,CHANGE PROGRAM PARAMETERS,EXIT PROGRAM
  541. 9040  DATA 5
  542. 9060  DATA NUMBER RANGE,NUMBER LIST,NAME SET,LIST IN MEMORY,CLEAR LIST IN MEMORY
  543. 9100  DATA 25
  544. 9101  DATA USE MONTH NAMES
  545. 9102  DATA MAXIMUM GENERATIONS
  546. 9103  DATA SHOW ID WITH NAMES
  547. 9104  DATA TOP-OF-FORM AFTER PRINTS
  548. 9105  DATA FIRST SHEET NUMBER
  549. 9106  DATA USE OVERLAY FORMAT
  550. 9107  DATA CASCADE STANDARD CHARTS
  551. 9108  DATA PRINT SIZE
  552. 9109  DATA NUMBER STANDARD CHARTS
  553. 9110  DATA USE LAST NAME FIRST
  554. 9111  DATA SUBSTITUTE SIMILAR FIELDS
  555. 9112  DATA SHOW MARRIED NAME
  556. 9113  DATA TAB BEFORE HEADER
  557. 9114  DATA USE CUSTOM HEADER
  558. 9115  DATA LINES PER PAGE
  559. 9116  DATA NOT USED
  560. 9117  DATA SIZE OF LEFT MARGIN
  561. 9118  DATA USE PREVIOUS HEADER
  562. 9119  DATA SUBSTITUTE SPECIAL ID
  563. 9120  DATA NOT USED
  564. 9121  DATA NOT USED
  565. 9122  DATA USE FULL ADDRESS
  566. 9123  DATA SUPPRESS DUPLICATION
  567. 9124  DATA OMIT WIFE'S MARRIAGE
  568. 9125  DATA ASK WHICH MARRIAGE
  569. 9150  DATA 1,0,1,1,0,1,1,0,1,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,1
  570. 16000  GOSUB 16500:V$ = Q$(39):C4 = 0: GOSUB 850: PRINT  CHR$(4)"PR#"Q(43): READ H: FOR I = 1 TO H: READ H$(I): NEXT 
  571. 16070  READ OB: FOR I = 1 TO OB: READ H1$(I): NEXT 
  572. 16080  READ OP: FOR I = 1 TO OP: READ OP$(I): NEXT : FOR I = 1 TO OP: READ TY(I): NEXT : GOSUB 1680
  573. 16090  PRINT  CHR$(4)"CLOSE":FF = 0:FS = 0:CH$ = "":CI$ = "":IQ = 0:KN = 0:C = 0: GOSUB 850: HTAB (Q(22) -33)/2: INVERSE : PRINT "TRADITIONAL CHART PRINTING PROGRAM": NORMAL : PRINT : PRINT "WHICH DO YOU WANT TO DO:": PRINT 
  574. 16100  FOR X = 1 TO H: PRINT  CHR$(64 +X)") "H$(X): NEXT 
  575. 16110  PRINT : INVERSE : PRINT "CHOICE (A-" CHR$(64 +H)")?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN 6760
  576. 16115  IF YN$ = "P"  THEN YN$ =  CHR$(63 +H)
  577. 16120 C1 =  ASC(YN$) -64: IF C1 <1  OR C1 >H  THEN 16110
  578. 16130  IF C1 = H  THEN 6760
  579. 16140  IF C1 <H -1  THEN  GOSUB 16170: GOTO 16090
  580. 16150  GOSUB 1600: GOTO 16090
  581. 16170  PRINT : PRINT H$(C1)" BY:": PRINT :L = 3: IF LO >0  THEN L = 4
  582. 16180  FOR X = 1 TO L: PRINT  CHR$(64 +X)") "H1$(X): NEXT 
  583. 16200  PRINT : INVERSE : PRINT "CHOICE (A-" CHR$(64 +L)"/P/M)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  584. 16202  IF YN$ = "P"  THEN  GOSUB 1600: GOSUB 850: GOTO 16170
  585. 16203  IF YN$ = "M"  THEN  GOSUB 840: GOTO 16170
  586. 16205 C3 =  ASC(YN$) -64: IF C3 <1  OR C3 >L  THEN 16200
  587. 16206  IF C3 = 5  THEN LO = 0:CH = 0: GOTO 16170
  588. 16210  PRINT :X2 = OP(5):T = 1: GOSUB 8800:T = 0:Y1 = 0:X3 = 1: ON C3 GOSUB 1000,740,1260,767
  589. 16220  RETURN 
  590. 16500  ONERR  GOTO 16700
  591. 16510  PRINT  CHR$(4)"OPENCONFIGURATION": PRINT  CHR$(4)"READCONFIGURATION": FOR I = 1 TO 84: INPUT A: NEXT 
  592. 16520  FOR I = 1 TO 50: CALL LI: NEXT : FOR I = 1 TO 14: INPUT A: NEXT 
  593. 16530  FOR I = 1 TO 4: INPUT OP(I): NEXT : INPUT OP(17): INPUT A: INPUT OP(19): INPUT A: INPUT OP(10): INPUT A: INPUT OP(7): INPUT A: FOR I = 12 TO 14: INPUT OP(I): NEXT 
  594. 16540  INPUT A: INPUT A: INPUT OP(18): INPUT OP(20): INPUT OP(5): FOR I = 21 TO 23: INPUT OP(I): NEXT : FOR I = 1 TO 9: INPUT A: NEXT : INPUT OP(2): INPUT OP(6): INPUT OP(9): INPUT OP(11): INPUT OP(16): INPUT OP(24): INPUT OP(8): INPUT OP(25): INPUT OP(26)
  595. 16550  PRINT  CHR$(4)"CLOSE":OP(15) = Q(62): POKE 216,0: RETURN 
  596. 16700 A =  PEEK(222): IF A = 5  OR A = 6  OR A = 8  THEN  PRINT "NO CONFIGURATION FILE AVAILABLE ON DISK";: GOSUB 860: PRINT "LAST USED. PLEASE SEE MANUAL.": END 
  597. 16720  GOSUB 600: PRINT "ERROR # " PEEK(222)" AT LINE " PEEK(218) +256 * PEEK(219)". PLEASE SEE";: GOSUB 860: PRINT "DOS MANUAL.";: GOSUB 690: GOTO 20000
  598. 19000 LO = CH: ONERR  GOTO 19020
  599. 19010  POP : GOTO 19010
  600. 19020  POKE 216,0: GOTO 16090
  601. 20000  GOTO 19000